home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 19 / CU Amiga Magazine's Super CD-ROM 19 (1998)(EMAP Images)(GB)[!][issue 1998-02].iso / CUCD / Online / Apache / cgi-bin / counter < prev    next >
Text File  |  1997-07-20  |  21KB  |  813 lines
  1. #!/usr/bin/perl
  2.  
  3. # cgi-bin access counter program
  4. # Version 4.0.7
  5. #
  6. # Copyright (C) 1995 George Burgyan
  7. #
  8. # This program is free software; you can redistribute it and/or modify
  9. # it under the terms of the GNU General Public License as published by
  10. # the Free Software Foundation; either version 2 of the License, or (at
  11. # your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful, but
  14. # WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  16. # General Public License for more details.
  17. #
  18. # A full copy of the GNU General Public License can be retrieved from
  19. # http://www.webtools.org/counter/copying.html
  20. #
  21. # gburgyan@webtools.org
  22. #
  23. # George Burgyan
  24. # 1380 Dill Road
  25. # South Euclid, OH 44121
  26. #
  27. # For more information look at http://www.webtools.org/counter/
  28.  
  29. ########################################################################
  30. #
  31. #   CHANGE THESE TO SUIT YOUR SITE
  32. #
  33.  
  34. # The default language option (english, french, swedish)
  35. $default_lang = "english";
  36.  
  37. # The name of the file to use.    You should probably give this an absolute path
  38. $FileName = "/apache/logs/access_count";
  39.  
  40. # Replace with a list of regular expression IP addresses that we
  41. # are supposed to ignore.  If you don't know what this means, just use
  42. # "\." instead of periods.  Comment out entirely to ignore nothing.
  43.  
  44. #@IgnoreIP = ("199\.18\.203\..*",
  45. #     "199\.18\.159\.1",
  46. #     );
  47.  
  48. # Aliases: Set this up so that diffent pages will all yield the same
  49. # count.  For instance, if you have a link like "index.html -> home.html"
  50. # set it up like ("/index.html", "/home.html").  Make sure you give a full
  51. # path to it. This will treat "/index.html" as if it were "/home.html".
  52.  
  53. %Aliases = ("/fakename.html", "/realname.html",
  54.         "/index.html", "/home.html", "/index.shtml"
  55.        );
  56.  
  57.  
  58. # AUTOMATICALLY SET BY INSTALL!!   Modify only if necessary!!!
  59. #
  60. # BaseName: set to whatever you have counter installed as.  This is
  61. # used to derive the arguments.  No not touch the next comment.
  62.  
  63. ### AUTOMAGIC ###
  64. $BaseName = "counter";
  65.  
  66. # counter  or  counterbanner  or  counterfiglet
  67. #
  68. # Outputs the number of times a specific page has been accessed.
  69. # The output depends on which page 'called' it, and what the program
  70. # is named:
  71. #
  72. # The counter can "take arguments" via its name.  That is, if you tack
  73. # -arg to the end of the program name, -arg is taken to be an argument.
  74. # For example, if you call the counter 'counter-ord', '-ord' is considered
  75. # an argument, and an ordinal count (1st, 2nd, 3rd, ...) will be printed
  76. # instead of (1, 2, 3, ...).  Note that counterord does the same thing as
  77. # counter-ord for backward compatibility.
  78. #
  79. # Currently recognized arguments:
  80. #
  81. #  -f=font  sets "font" to be the font for figlet
  82. #  -lang=lang    sets the language used to ordinalize to "lang"
  83. #  -nc        no count; don't to write the incremented count back to the file
  84. #  -nl        no link; don't automatically generate a link
  85. #  -nd        no display; don't display anything, just count
  86. #  -ord     make an ordinal count instead of regular
  87. #  -doc=document override the DOCUMENT_URI environment variable
  88. #
  89. # Example:  counterfiglet-ord-f=bigfont-nc
  90. #
  91. # This will cause the counter to call figlet as the output routine, printing
  92. # in a big font an ordinal count, without updating the access count file.
  93. # Note that the order of arguments is irrelevant so long as you spell the
  94. # file name correctly.    It is generally assumed that the ability to take
  95. # different arguments/use different output routines is done with symlinks:
  96. # i.e. ln -s counter counterfiglet-ord-f=bigfont-nc
  97. #
  98. # More complete documentation can be found at
  99. # http://www.webtools.org/counter/
  100. #
  101. ########################################################################
  102. #
  103. # Thing that shouldn't really need changing, but are configurable anyway.
  104. #
  105.  
  106. # Maximum number of times to try to lock the file.
  107. # Each try is .1 second.  Try for 1 second.
  108. $MaxTries = 10;
  109.  
  110. # Set this to point to something, or comment it out, and it
  111. # won't be a link at all.
  112. $Link = "http://www.webtools.org/counter/";
  113.  
  114. # Whether or not to use locking.  If perl complains that flock is not
  115. # defined, change this to 0.  Not *really* necessary because we check
  116. # to make sure it works properly.
  117. $UseLocking = 1;
  118.  
  119. # What version of the counter file format are we using?
  120. $FileVersion = "02.000";
  121.  
  122. # Common names of the counter to install...
  123. @CommonExtensions = ("-ord",    # Ordinam
  124.        "figlet",   # Figlet'ed
  125.        "figlet-ord",# Ordinal figlet
  126.        "banner",    # Bannered
  127.        "banner-ord",# Ordinal banner
  128.        );
  129. #
  130. #########################################################################
  131. #
  132. # Misc documents to refer people to in case of errors.
  133. #
  134. $CreateFile = "<a href=\"http://www.webtools.org/counter/faq.html#create\">[Error Creating Counter File -- Click for more info]</a>";
  135. $AccessRights = "<a href=\"http://www.webtools.org/counter/faq.html#rights\">[Error Opening Counter File -- Click for more info]</a>";
  136. $TimeoutLock = "[Timeout locking counter file]";
  137. $BadVersion = "<a href=\"http://www.webtools.org/counter/\">[Version access_count newer than this program.  Please upgrade.]</a>";
  138.  
  139. #########################################################################
  140. #
  141. # The actual program!
  142.  
  143. ### Stage 1
  144. ###
  145. ### Parse the arguments...  (just ignore this part)
  146.  
  147. # Get arguments from program name.  Argh...what a horrible way to do it!
  148. $prog = $0;
  149. $prog =~ s/(\.cgi|\.pl)//;      #strip .cgi|.pl name extension
  150. $prog =~ s!^(.*/)!!;    # separate program name
  151. $prog =~ s/\\(.)/sprintf("%%%02x", ord($1))/ge; # quote \c to %xx
  152.  
  153. ($printer, @args) = split(/-/, $prog); # args are separated by dashes
  154. $printer =~ s/%(..)/pack("c", hex($1))/ge; # unquote printer function name
  155. $printer =~ s/$BaseName/counter/; # Make it cannonical.
  156.  
  157. # This gets path info, which is only applicable if you are using our
  158. # ssis script (see above).  This makes counter/ord the same as counter-ord
  159. $path_info = $ENV{'FILEPATH_INFO'} || $ENV{'PATH_INFO'};
  160. push(@args, split("/", $path_info)) if $path_info;
  161.  
  162. # put them in assoc array %arg
  163. foreach (@args)   # means do this for each element in the array
  164. {
  165.     s/%(..)/pack("c", hex($1))/ge;  # unquote %xx
  166.     /^([^=]*)=?(.*)$/;        # extract "=" part, if any
  167.     $arg{$1} = $2 ? $2 : 1;
  168. }
  169.  
  170. if ($ARGV[0] eq '-install') {
  171.     &CheckPerl;
  172.     &SetBaseName;
  173.     &MakeCommon(0);
  174.     exit(0);
  175. }
  176.  
  177. if ($ARGV[0] eq '-installforce') {
  178.     &CheckPerl;
  179.     &SetBaseName;
  180.     &MakeCommon(1);
  181.     exit(0);
  182. }
  183.  
  184. if ($ARGV[0] eq '-unlock') {
  185.     open(FILE,"$FileName");
  186.     &UnlockFile(FILE);
  187.     exit(0);
  188. }
  189.  
  190. undef $Link if $arg{'nl'}; # make link?
  191.  
  192. ### Stage 2
  193. ###
  194. ### Print out the header
  195.  
  196. # Print out the header
  197. print "Content-type: text/html\n\n";
  198.  
  199.  
  200.  
  201. ### Stage 3
  202. ###
  203. ### Open the access_count file for read-write taking all the precautions
  204.  
  205. # Make sure the file exists:
  206. if (!(-f $FileName)) {
  207.     if (!open (COUNT,">$FileName")) {
  208.    # Can't create the file
  209.    print $CreateFile;
  210.    exit 1;
  211.     } else {
  212.    # We got the file, print out the version number
  213.    print COUNT "$FileVersion\n";
  214.    $version = 2;
  215.     }
  216. } else {
  217.     if (!((-r $FileName) && (-w $FileName))) {
  218.    # Make sure that we can in fact read and write to the file in
  219.    # question.    If not, direct them to the FAQ.
  220.    print $AccessRights;
  221.    exit 1;
  222.     }
  223.  
  224.     if (!open (COUNT,"+<$FileName")) { # Now make sure it *really* opens
  225.    print $AccessRights;     # ...just in case...
  226.    exit 1;
  227.     }
  228.  
  229.     # Try to read in a version number
  230.     $version = <COUNT>;
  231.     if (!($version =~ /^\d+.\d+$/)) {
  232.    # No version number, assume version 1 and reset the file.
  233.    $version = 1;
  234.    seek(COUNT,0,0);
  235.     }
  236. }
  237.  
  238. # This is for the future: the access_count file will have a version number.
  239. if ($version > 2) {
  240.     print $BadVersion;
  241.     exit 1;
  242. }
  243.  
  244. ### Stage 4
  245. ###
  246. ### Attempt to lock the file
  247.  
  248.  
  249. $lockerror = &LockFile(COUNT);
  250.  
  251. # You would figure that $MaxTries would equal 0 if it didn't work.  The
  252. # post-decrement takes it to -1 when the loop finally exits.
  253. if ($lockerror) {
  254.     print $TimeoutLock;
  255.     exit(0);
  256. }
  257.  
  258.  
  259. ### Stage 5
  260. ###
  261. ### Check if we need to update the file to a newer version
  262.  
  263. if ($version < 2) {
  264.     &UpdateVersion1;
  265. }
  266.  
  267.  
  268. ### Stage 6
  269. ###
  270. ### Convert the information the server gave us into the document
  271. ### identifier.
  272.  
  273. # Make sure perl doesn't spit out warnings...
  274. if (defined $ENV{'DOCUMENT_URI'}) {
  275.     $doc_uri = $ENV{'DOCUMENT_URI'};
  276. } else {
  277.     $doc_uri = "";
  278. }
  279.  
  280. # Campatibility: Version 2 files have the server name in front if and
  281. # only if it doesn't have a "~" in it.
  282.  
  283. $old_uri = $doc_uri;
  284.  
  285. # Add the server name in front to support multi-homed hosts if and only if
  286. # it doesn't have a "~" in it.  (usernames are global in most multi-homed
  287. # settings
  288. if (defined $ENV{'SERVER_NAME'} && !($doc_uri =~ /~/)) {
  289.     $doc_uri = $ENV{'SERVER_NAME'} . "/" . $doc_uri;
  290. }
  291.  
  292. if (defined $arg{'doc'}) {
  293.     $doc_uri = $arg{'doc'};
  294. }
  295.  
  296. $doc_uri = $Aliases{$doc_uri} if defined $Aliases{$doc_uri};
  297.  
  298.  
  299. ### Stage 7
  300. ###
  301. ### Find the relevant place in the file
  302.  
  303. $location = tell COUNT;
  304. while ($line = <COUNT>) {
  305.     # Read the file line-by-line.
  306.     if (($uri,$accesses) = ($line =~ /^'(\S*)' (\d\d\d\d\d\d\d\d\d\d)$/)) {
  307.    # An old line
  308.    if ($uri eq $old_uri) {
  309.        &ConvertDocV1($doc_uri,$old_uri,$accesses,$location);
  310.        last;
  311.    }
  312.     } elsif (($uri,$accesses,$flags) = ($line =~ /^'(\S*)' (\d\d\d\d\d\d\d\d\d\d) (\w\w\w\w)$/)) {
  313.    # A new line
  314.    if ($uri eq $doc_uri) {
  315.        $flags = hex($flags);
  316.        last;
  317.    }
  318.     }
  319.  
  320.     last if ($uri eq $doc_uri);
  321.     $location = tell COUNT;
  322.  
  323.     #reset the fields
  324.     $accesses = 0;
  325.     $flags = 0;
  326. }
  327.  
  328.  
  329. ### Stage 8
  330. ###
  331. ### Update the access count of the file
  332.  
  333. $accesses += 1;   # *NOT* '++' because we don't want '++'s magic
  334.  
  335.  
  336. ### Stage 9
  337. ###
  338. ### Figure out what to print out
  339.  
  340. # If we have to ordinalize, do it now.
  341. if (defined $arg{'ord'}) {
  342.     if (defined $arg{'lang'}) {
  343.    $ord = eval("&ordinalize_$arg{lang}($accesses)");
  344.     } else {
  345.    $ord = &ordinalize($accesses);
  346.     }
  347. } else {
  348.     $ord = "";
  349. }
  350. $to_print = $accesses . $ord;
  351.  
  352. # Give it to the printer function to actually produce the output from the
  353. # ascii text that we have (to_print)
  354. ($count, $nLink) = eval("&output_$printer('$to_print')");
  355.  
  356. # If the above line gave us an error, default to just the text.
  357. if ($@) {
  358.     ($count, $nLink) = &output_counter($to_print);
  359. }
  360.  
  361. ### Stage 10
  362. ###
  363. ### Now we actually tell the browser what the count is.
  364.  
  365. if (! $arg{"nd"} ) {    # If we print anything
  366.     # Print out a link to something informative (if we were requested to)
  367.     print "<a href=\"$nLink\">" if $nLink;
  368.     print $count;
  369.     print "</a>" if $nLink;
  370. }
  371.  
  372.  
  373. ### Stage 11
  374. ###
  375. ### Check if we are supposed to update the count in the file.  (ie. we're
  376. ### not ignoring the host that just accessed us)
  377.  
  378. # Make sure we are not ignoring the host:
  379.  
  380. $ignore = 0;
  381. $ignore = grep($ENV{"REMOTE_ADDR"} =~ /$_/, @IgnoreIP) if defined ($ENV{"REMOTE_ADDR"});
  382. $ignore = $ignore || $arg{"nc"};
  383.  
  384. ### Stage 12
  385. ###
  386. ### Actually write the updated information back to the file
  387.  
  388. if (!$ignore)        # If we aren't ignoring this access
  389. {
  390.     # Now update the counter file
  391.     seek(COUNT, $location, 0);
  392.     $longaccesses = sprintf("%010.10d", $accesses);
  393.     $hexflags = sprintf("%04.4x", $flags);
  394.     print COUNT "'$doc_uri' $longaccesses $hexflags\n";
  395. }
  396.  
  397. &UnlockFile(COUNT);
  398.  
  399. close COUNT;
  400.  
  401. #######################################################################
  402. #
  403. # Support functions
  404. #
  405.  
  406. # translate_output
  407. #
  408. # Quote any special characters with HTML quoting.
  409.  
  410. sub translate_output {
  411.     local($string) = @_;
  412.  
  413.     $_ = $string;
  414.  
  415.     s/è/è/g;
  416.  
  417.     return $_;
  418. }
  419.  
  420. sub LockFile {
  421.     local(*FILE) = @_;
  422.     local($TrysLeft) = $MaxTries;
  423.  
  424.     if ($UseLocking) {
  425.    # Try to get a lock on the file
  426.    while ($TrysLeft--) {
  427.  
  428.        # Try to use locking, if it doesn't use locking, the eval would
  429.        # die.  Catch that, and don't use locking.
  430.  
  431.        # Try to grab the lock with a non-blocking (4) exclusive (2) lock.
  432.        # (4 | 2 = 6)
  433.        $lockresult = eval("flock(COUNT,6)");
  434.  
  435.        if ($@) {
  436.       $UseLocking = 0;
  437.       last;
  438.        }
  439.  
  440.        if (!$lockresult) {
  441.       select(undef,undef,undef,0.1); # Wait for 1/10 sec.
  442.        } else {
  443.       last;    # We have gotten the lock.
  444.        }
  445.    }
  446.     }
  447.  
  448.     if ($TrysLeft >= 0) {
  449.    # Success!
  450.    return 0;
  451.     } else {
  452.    return -1;
  453.     }
  454. }
  455.  
  456. sub UnlockFile {
  457.     local(*FILE) = @_;
  458.  
  459.     if ($UseLocking) {
  460.    flock(FILE,8);       # Unlock the file.
  461.     }
  462. }
  463.  
  464.  
  465. ####################################################################
  466. #
  467. # Installation helpers
  468. #
  469.  
  470.  
  471. # SetBaseName
  472. #
  473. # Change the counter program itself to set the basename
  474.  
  475. sub SetBaseName {
  476.     local($name) = $0;
  477.  
  478.     $name =~ s/^.*\/([^\/]+)$/$1/; # Strip off any of the path
  479.  
  480.     if ($name eq $BaseName) { # The way we're set up now!!!
  481.    return;      # Don't need to change a thing.
  482.     }
  483.  
  484.     if (!open(COUNTERFILE, "+<$0")) {
  485.    print "Can't modify program.  Set \$BaseName manually.\n";
  486.    return;
  487.     }
  488.  
  489.     print "Configuring \$BaseName variable...\n";
  490.  
  491.     local($oldsep) = $/;
  492.     undef($/);
  493.  
  494.     local($program) = <COUNTERFILE>;
  495.  
  496.     # The next line does all the magic.
  497.     $program =~ s/\#\#\# AUTOMAGIC \#\#\#\n\$BaseName = \"[^\"]+\";\n/\#\#\# AUTOMAGIC \#\#\#\n\$BaseName = \"$name\";\n/;
  498.  
  499.     seek(COUNTERFILE,0,0) || return;
  500.     truncate(COUNTERFILE,0);
  501.     print COUNTERFILE $program;
  502.     close COUNTERFILE;
  503. }
  504.  
  505. # CheckPerl
  506. #
  507. # Make sure that the "#! /[path]/perl" points to something real...
  508.  
  509. sub CheckPerl {
  510.     if (!open(COUNTERFILE, "<$0")) {
  511.    print "Can't check to make sure Perl is in the right place.\n";
  512.    return;
  513.     }
  514.     print "Checking to make sure Perl is found properly...\n";
  515.  
  516.     $firstline = <COUNTERFILE>;
  517.     ($command) = ($firstline =~ /^\#! *([^\s]+) *$/);
  518.     close(COUNTERFILE);
  519.  
  520.     if (! -x $command) {
  521.    print "The location of Perl is misconfigured.  Please edit the\n";
  522.    print "first line of this program to point to the locally installed\n";
  523.    print "copy of perl.\n\n";
  524.    print "Currently, it is configured to be \"$command\", however,\n";
  525.    print "that file either does not exist or is not a program.\n\n";
  526.    print "Some common locations for Perl are:\n";
  527.    print "  /usr/bin/perl\n";
  528.    print "  /usr/local/bin/perl\n";
  529.    print "  /bin/perl\n";
  530.    print "  /opt/gnu/bin/perl\n\n";
  531.     exit;
  532.     }
  533. }
  534.  
  535. # MakeCommon
  536. #
  537. # Make some common links to the counter
  538.  
  539. sub MakeCommon {
  540.     local($force) = @_;
  541.     local($ext);
  542.  
  543.     print "Installing the counter...\n";
  544.     print "   ...making counter executable\n";
  545.     chmod(0755,$0);
  546.  
  547.     local($path, $name, $cgi);
  548.     $name = $0;
  549.     if ($name =~ /^(.*\/)([^\/]+)$/) {
  550.    $path = $1; $name = $2;
  551.     }
  552.     if ($name =~ /^(.*)(\.cgi)$/) {
  553.    $name = $1, $cgi = $2;
  554.     }
  555.  
  556.     foreach $ext (@CommonExtensions) {
  557.    print  "   ...making link from $path$name$cgi to $path$name$ext$cgi\n";
  558.    if (!&MakeLink("$path$name$cgi","$path$name$ext$cgi",$force)) {
  559.        # An error occured while making the link.  :-(
  560.  
  561.        print "     *** An error occured while making the link.\n";
  562.    }
  563.     }
  564.     if ($symlink_exists == 0 && $link_exists == 0) {
  565.    print "* NOTE *  Your system does not support symbolic or hard links,\n";
  566.     print "          copies made instead.  If you modify the counter, you must\n";
  567.    print "          run counter -install again to recopy it to the other files.\n";
  568.     }
  569.  
  570.     print "...done!\n";
  571. }
  572.  
  573. # MakeLink
  574. #
  575. # Actually create the link.
  576.  
  577. sub MakeLink {
  578.     local($oldname,$newname,$force) = @_;
  579.  
  580.     # Check to see if we can make symbolic links instead of hard links
  581.     if (!defined $symlink_exists) {
  582.    $symlink_exists = (eval 'symlink("","");', $@ eq '');
  583.     }
  584.  
  585.     # Check to see if we can make a link if we can't make a symlink
  586.     if (!symlink_exists) {
  587.    $link_exists = (eval 'link("","");', $2 eq '');
  588.     }
  589.  
  590.     if ($force) {
  591.    # Check to see if the file exists
  592.    if (-e $newname) {
  593.        if (!unlink ($newname)) {
  594.       return 0;
  595.        }
  596.    }
  597.     }
  598.  
  599.     if ($symlink_exists) {
  600.    return symlink($oldname, $newname);
  601.     } elsif ($link_exists) {
  602.    return link($oldname, $newname);
  603.     } else {
  604.    # Copy it the old-fashioned way...  *sigh*
  605.    open(OLDFILE, $oldname) || die "Can't open $oldname for copy";
  606.    open(NEWFILE, ">$newname") || die "Can't open $newname for write";
  607.    while(<OLDFILE>) {
  608.        print NEWFILE $_;
  609.    }
  610.    close(NEWFILE);
  611.    close(OLDFILE);
  612.     }
  613. }
  614.  
  615. ####################################################################
  616. #
  617. # Ordinalizing functions
  618. #
  619.  
  620. # ordinalize
  621. #
  622. # Call the appropriate ordinalize function for the default language
  623.  
  624. sub ordinalize
  625. {
  626.     local($count) = @_;
  627.  
  628.     if (defined $arg{'lang'}) {
  629.    return eval("&ordinalize_$arg{lang}($count)");
  630.     } else {
  631.    return eval("&ordinalize_$default_lang($count)");
  632.     }
  633. }
  634.  
  635.  
  636. # ordinalize_english
  637. #
  638. # Figure out what suffix (st, nd, rd, th) a number would have in ordinal
  639. # form and return that extension.
  640.  
  641. sub ordinalize_english {
  642.     local($count) = @_;
  643.     local($last, $last2);
  644.  
  645.     $last2 = $count % 100;
  646.     $last = $count % 10;
  647.  
  648.     if ($last2 < 10 || $last2 > 13) {
  649.    return "st" if $last == 1;
  650.    return "nd" if $last == 2;
  651.    return "rd" if $last == 3;
  652.     }
  653.  
  654.     return "th";     # Catch "eleventh, twelveth, thirteenth" etc.
  655. }
  656.  
  657. # ordinalize_french
  658. #
  659. # Trivial...  Return the extension for french.    The only exception is 1.
  660. # Thank you Chris Polewczuk <chris@hexonx.com>
  661.  
  662. sub ordinalize_french {
  663.     local ($count) = @_;
  664.  
  665.     if ($count == 1) {
  666.    return "'ière";
  667.     } else {
  668.    return "ième";
  669.     }
  670. }
  671.  
  672. # ordinalize_swedish
  673. #
  674. # A function to ordinalize in Swedish.    Thanks go to Johan Linde
  675. # <jl@theophys.kth.se> for the code!
  676.  
  677. sub ordinalize_swedish {
  678.     local($count) = @_;
  679.     local($last, $last2);
  680.  
  681.     $last2 = $count % 100;
  682.     $last = $count % 10;
  683.  
  684.     if ($last2 < 10 || $last2 > 12) {
  685.     return ":a" if ($last == 1 || $last == 2);
  686.     }
  687.  
  688.     return ":e";
  689. }
  690.  
  691.  
  692. ########################################################################
  693. #
  694. # Output functions
  695. #
  696. # The following are the routines that actually convert the number
  697. # of accesses into something that we print out.
  698. #
  699. # The name of each function is "output_" followed by the program's name.
  700. # For instance, is the program is called "counter" then "output_counter"
  701. # will be called; a program called "counterbanner" will call
  702. # "output_counterbanner" to get the output.
  703. #
  704. # If the function is not defined, then "output_counter" will be called.
  705. #
  706.  
  707. # output_counter
  708. #
  709. # The simplest function: just returns the number of accesses and the link.
  710.  
  711. sub output_counter {
  712.     local($count) = @_;
  713.  
  714.     return &translate_output($count), $Link; # we return the count and the link
  715. }
  716.  
  717.  
  718. # output_counterord
  719. #
  720. # Return the number of accesses as an ordinal number.  (ie. 1st, 2nd, 3rd, 4th)
  721.  
  722. sub output_counterord {
  723.     local($count) = @_;
  724.  
  725.     return &translate_output($count . &ordinalize($count)), $Link;
  726. }
  727.  
  728.  
  729. # output_counterbanner
  730. #
  731. # A somewhat silly one that uses the "banner" command to print out the
  732. # count.  :)  You might need to change the path to make it work.
  733.  
  734. sub output_counterbanner {
  735.     local($count) = @_;
  736.  
  737.     $banner = `banner $count`;
  738.  
  739.     return "<pre>$banner</pre>"; # return no link here (it would be annoying)
  740. }
  741.  
  742.  
  743. # output_counterfiglet
  744. #
  745. # An even sillier one than counterbanner.  :)
  746.  
  747. sub output_counterfiglet {
  748.     local($count) = @_;
  749.  
  750.     $fig = "echo $count | /usr/games/figlet";   # setup command line
  751.     $fig .= " -f $arg{'f'}" if $arg{"f"}; # use a different font?
  752.     $fig = `$fig`;
  753.     $fig =~ s!&!&!g;
  754.     $fig =~ s!<!<!g;
  755.     return "<br><pre>" . $fig . "</pre>"; # note no link here, either
  756. }
  757.  
  758.  
  759.  
  760. #########################################################################
  761. #
  762. # Conversion functions
  763. #
  764.  
  765. # UpdateVersion
  766. #
  767. # Convert a version 1file into a version 2 file.
  768.  
  769. sub UpdateVersion1 {
  770.     local ($contents,$dummy);
  771.     local ($oldsep) = $/;
  772.  
  773.     $/ = "";
  774.     seek(COUNT,0,0);    # Go to the beginning of the file
  775.     $contents = <COUNT>;
  776.     seek(COUNT,0,0);
  777.     print COUNT "$FileVersion\n";
  778.     print COUNT $contents;
  779.     seek(COUNT,0,0);
  780.     $/ = $oldsep;
  781.     $dummy = <COUNT>;       # Skip the new line
  782. }
  783.  
  784.  
  785. # ConvertDocV1
  786. #
  787. # Convert the a version 1 line into a version 2 line
  788.  
  789. sub ConvertDocV1 {
  790.     local ($doc_uri,$old_uri,$accesses,$location) = @_;
  791.     local ($contents,$dummy,$oldsep);
  792.  
  793.     $oldsep = $/;
  794.  
  795.     seek (COUNT,$location,0); # Skip the line in question
  796.     $dummy = <COUNT>;
  797.  
  798.     $/ = "";         # Read in the whole file
  799.     $contents = <COUNT>;
  800.  
  801.     seek (COUNT,$location,0);
  802.  
  803.     local ($longaccesses,$hexflags);
  804.     $longaccesses = sprintf("%010.10d", $accesses);
  805.     $hexflags = sprintf("%04.4x", $flags);
  806.  
  807.     # Print out the new stuff
  808.     print COUNT "'$doc_uri' $longaccesses $hexflags\n";
  809.     print COUNT $contents;
  810.  
  811.     $/ = $oldsep;
  812. }
  813.